perm filename MAKVID.SAI[GEO,BGB] blob sn#001317 filedate 1972-09-01 generic text, type T, neo UTF8
00100	ENTRY DUMMY;
00200	BEGIN "MAKVID  -  MAKE VIDEO IMAGE  -  AUGUST 1972"
00300		REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400		REQUIRE "WINGED.SAI" SOURCE_FILE;
00500	
00600		PRELOAD_WITH 7,0,6,288,48,20,235,28,315,10368;
00700		ITG ARRAY HEADER[0:9];
00800	
00900		EXTERNAL PROCEDURE FACOEF (ITG B,FLG);
01000	
01100		SAFE ITG ARRAY PIXEL[0:287];
01200	
01300		REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
01400		SAFE ITG ARRAY DPYBUF[1:500];
     

00100	INTERNAL PROCEDURE MAKVID;
00200	BEGIN "MAKVID"
00300		SAFE ITG ARRAY TVBUF[0:10367];
00400		ITG ROW,COL,CHN,FLG;
00500	
00600	α STORE PIXEL BRIGHTNESS INTO RASTER;
00700		SUBR DOT→(ITG BRT;SHORT REAL X,Y);
00800	BEGIN
00900		ITG ROW,COL,PTR,BYT;
01000		ROW ← 108 - Y; ROW ← (0 MAX ROW)MIN 215;
01100		COL ← X + 144; COL ← (0 MAX COL)MIN 287;
01200		PTR ← POINT(6,TVBUF[ROW*48+(COL DIV 6)],6*(COL MOD 6)+5);
01400		BYT ← LDB(PTR);
01500		DPB(BRT MAX BYT,PTR);
01600	END;
     

00100	SUBR RASTERIZE (ITG E);
00200	BEGIN "RASTERIZE"
00300	
00400		SHORT REAL X1,Y1,X2,Y2; ITG V1,V2,LX,LY;
00500		ITG I1,I2,NF,PF;
00600		REAL A,B,C,Q,FC,X,Y;
00700		ITG I,L,BRT,NBRT,PBRT;
00800		EXTERNAL REAL PROCEDURE SQRT (REAL X);
00900		ITG JAG,UFACE;
01000		EXTERNAL ITG BGND;
01100	
01200	α PICK HER UP & GET V1 ON TOP;
01300		JAG ← CAR(E)LAND '020100;
01400		IF JAG≠0 THEN JAG←+1;
01500		V1 ← NVT(E);
01600		V2 ← PVT(E);
01700		IF YPP(V1)<YPP(V2) THEN ⊂ V1↔V2;JAG←-JAG;⊃;
01800	
01900	
02000		A ← YPP(V1) - YPP(V2);
02100		B ← XPP(V2) - XPP(V1);
02200		C ← XPP(V1)*YPP(V2) - XPP(V2)*YPP(V1);
02300		Q ← SQRT(A↑2+B↑2); A←A/Q;B←B/Q;C←C/Q;
02400	
02500		X ← X1 ← XPP(V1); X2 ← XPP(V2);
02600		Y ← Y1 ← YPP(V1); Y2 ← YPP(V2);
02700	
02800		I1←X1;I2←X2;LX←ABS(X1-X2);
02900		I1←Y1;I2←Y2;LY←ABS(Y1-Y2);
03000		L ← LX+LY;
03100	
03200		NF ← (IF CAR(E)LAND '100 THEN CDR(E+7) ELSE NFACE(E));
03250		PF ← PFACE(E);
03300		FC ← (IF(NF=BGND)THEN ABS(CC(PF)) ELSE
03400			(ABS(CC(PF))+ABS(CC(NF)))/2);
03500		IF JAG≠0 THEN IF NF=BGND THEN NBRT←1 ELSE
03600		⊂ NBRT←((4 MAX CC(NFACE(E))*64)MIN '77);
03700		  NBRT←NBRT LAND '76;⊃;
03800		BRT ← ((4 MAX FC*64)MIN '77);
03900		BRT ← BRT LAND '76;
     

00100		IF JAG THEN DOT→(NBRT,X+JAG,Y);
00200	α DOWN AND RIGHT;
00300		IF X2≥X1 THEN
00400		FOR I←1 TO L DO
00500	BEGIN
00600		DECREM(Y);
00700		INCREM(X);
00800		Q ← A*X + B*Y + C;
00900		IF Q≤0 THEN INCREM(Y) ELSE ⊂ DECREM(X);
01000		IF JAG=+1 THEN DOT→(NBRT,X+1,Y+1) ELSE
01100		IF JAG=-1 THEN DOT→(NBRT,X-1,Y);⊃;
01200		DOT→(BRT,X,Y);
01300	END;
01400	
01500	α DOWN AND LEFT;
01600		IF X2<X1 THEN
01700		FOR I←1 TO L DO
01800	BEGIN
01900		DECREM(Y);
02000		DECREM(X);
02100		Q ← A*X + B*Y + C;
02200		IF Q≤0 THEN ⊂ INCREM(X);
02300		IF JAG=+1 THEN DOT→(NBRT,X+1,Y) ELSE
02400		IF JAG=-1 THEN DOT→(NBRT,X-1,Y+1);
02500		⊃ ELSE INCREM(Y);
02600		DOT→(BRT,X,Y);
02700	END;
02800		IF JAG THEN DOT→(NBRT,X+JAG,Y);
     

00100		IF ABS(X-X2)≥1 ∨ ABS(Y-Y2)≥1 THEN 
00200	BEGIN
00300		OUTSTR("END-POINT MISMATCH: "&9&CVG(X-X2)&9&CVG(Y-Y2)&↓);
00400		OUTSTR(9&"L = "&CVS(L)&" = "&
00500			CVG(ABS(XPP(V1)-XPP(V2))+ABS(YPP(V1)-YPP(V2)) )&↓);
00600		OUTSTR(9&"X1 = "&CVG(X1));
00700		OUTSTR(9&"Y1 = "&CVG(Y1));
00800		OUTSTR(↓);
00900		OUTSTR(9&"X2 = "&CVG(X2));
01000		OUTSTR(9&"Y2 = "&CVG(Y2));
01100		OUTSTR(↓);
01200		OUTSTR(9&"X  = "&CVG(X ));
01300		OUTSTR(9&"Y  = "&CVG(Y ));
01400		OUTSTR(↓);
01500		INCHRW;
01600	END;
01700	
01800	
01900	END "RASTERIZE";
     

00100		LABEL L1,L2;
00200		ITG B,E;
00300	
00400		B ← WORLD;
00500	L1:	B ← PBODY(B);
00600		IF BTYPE(B) THEN ⊂ 
00700	α	FACOEF(B,FALSE);
00800		E←B;
00900	L2:	E ← PED(E);
01000		IF ETYPE(E) THEN ⊂
01100	α VISIBLE OR POTENT;
01200		IF ('60 LAND(CAR(E))≠0) THEN RASTERIZE(E); 
01300	GO L2;⊃;
01400	GO L1;⊃;
     

00100	α FILL IN TV RASTER BY LINEAR INTERPOLATION;
00200		FOR ROW←0 TO 215 DO
00300	BEGIN	"FILL"
00400		LABEL L1,L2;
00500		ITG XX,YY,YDEL,VAL;
00600		INTEGER PTR,PTR0,I,I1,I2,Z,DX,DZ;
00700		DPYSET(DPYBUF); AIVECT(-511,YY←(3.5*(108-ROW)));
00800		DPYSST(CVS(ROW));
00900		AVECT(511,(3.5*(108-ROW)));DPYBIG(1);
01000	
01100	α PICK 'EM UP;
01200		PTR0 ← PTR ← POINT(6,TVBUF[ROW*48],-1);
01300		VAL←YDEL←0;
01400		FOR I←0 TO 287 DO 
01500	BEGIN
01600		PIXEL[I]←(ILDB(PTR) LSH 18);
01700		YDEL←0 MAX(YDEL-3);
01800		IF PIXEL[I]≠0 ∧ (PIXEL[I]='1000000 ∨ PIXEL[I]≠VAL) THEN
01900	BEGIN
02000		VAL ← PIXEL[I] LSH -18;
02100		AIVECT(XX←3.5*(I-144),YY);
02200		IF VAL≠1 THEN ⊂ YDEL ← YDEL+20;
02300		AVECT(XX,YY+YDEL);⊃ ELSE AVECT(XX,YY-20);
02400		DPYSST(CVS(VAL));
02500	END;
02600	END;
02700	DPYOUT(7);
02800	
02900		I2←0;
03000	α LOOK FOR BLANK PIXELS;
03100	L1:	I1←I2; DO INCREM(I2) UNTIL PIXEL[I2]∨I2=287;
03200		Z ← PIXEL[I1];
03300		DX ← (I2-I1);
03400		DZ ← (PIXEL[I2]-Z)/DX;
03500	
03600	α FILL THE BLANKS BY LINEAR INTERPOLATION;
03700		IF DZ=0 THEN
03800		ARRBLT(PIXEL[I1+1],PIXEL[I1],(DX-1)) ELSE
03900		FOR I←(I1+1) TO (I2-1) DO
04000		PIXEL[I]←(Z←Z+DZ)LAND '76000000;
04100	
04200	α PUT 'EM BACK;
04300	L2:	PTR ← PTR0;
04400		FOR I←0 TO 287 DO IDPB((PIXEL[I]LSH -18),PTR);
04500		IF I2<287 THEN GO L1;
04600	END "FILL";
     

00100	α OUTPUT VIDEO IMAGE DSK FILE;
00200		CHN ← GETCHAN;
00300		OPEN(CHN,"DSK",8,0,3,0,0,0);
00400		ENTER(CHN,"TMP.TMP[DAT,BGB]",FLG);
00500		ARRYOUT(CHN,HEADER[0],10);
00600		ARRYOUT(CHN,TVBUF[0],10367);
00700		RELEASE(CHN);
00800		OUTSTR(9&"MAKVID EOF"&↓);
00900	END "MAKVID";
01000	END;